home *** CD-ROM | disk | FTP | other *** search
/ Microsoft Internet Strate…Tools for the Enterprise / Microsoft Internet Strategy & Tools for the Enterprise.iso / content / devel.tls / icp / vbsamp / httpexpl.exe / HTTPFCNS.BAS < prev   
BASIC Source File  |  1996-03-08  |  6KB  |  138 lines
  1. Attribute VB_Name = "tmpFunctions"
  2. Option Explicit
  3. '------------------------------------------------------------
  4. Public Function GetTempFileFromURL(URL As String, tmpName As String) As Boolean
  5. '------------------------------------------------------------
  6.     Dim tmpPath As String
  7.     Dim lenPath As Long
  8.     Dim pos As Long
  9.     Dim rc As Long
  10. '------------------------------------------------------------
  11.     tmpPath = Space$(255)
  12.     lenPath = Len(tmpPath)
  13.     rc = GetTempPath(lenPath, tmpPath)
  14.     
  15.     If (rc < 2) Then Exit Function
  16.     tmpPath = Left$(tmpPath, rc)
  17.     
  18.     If (Asc(Right$(tmpPath, 1)) = 0) Then tmpPath = Left$(tmpPath, rc - 1)
  19.     If (Right$(tmpPath, 1) <> "\") Then tmpPath = tmpPath & "\"
  20.     
  21.     For pos = Len(URL) To 1 Step -1
  22.         If (Mid$(URL, pos, 1) = "/") Then
  23.             tmpName = tmpPath & Mid$(URL, pos + 1)
  24.             Exit For
  25.         End If
  26.     Next
  27.     
  28.     If ((tmpName <> tmpPath) And (Dir$(tmpName) <> "")) Then Exit Function
  29.     
  30.     GetTempFileFromURL = True                               ' Return success
  31. '------------------------------------------------------------
  32. End Function
  33. '------------------------------------------------------------
  34.  
  35. '------------------------------------------------------------
  36. Public Sub ShellURLDoc(hWnd As Long, httpDocName As String)
  37. '------------------------------------------------------------
  38.     Dim rc As Long
  39.     Dim docPath As String
  40.     Dim docName As String
  41.     Dim pos As Long
  42. '------------------------------------------------------------
  43.     docName = Dir$(httpDocName)
  44.     If (docName <> "") Then
  45.         pos = InStr(1, httpDocName, docName) - 1
  46.         If (pos > 0) Then
  47.             docPath = Mid(httpDocName, 1, pos)
  48.             rc = ShellExecute(hWnd, "open", httpDocName, 0, docPath, SW_SHOWDEFAULT)
  49. Debug.Print "ShellExecute:rc:", rc
  50.         End If
  51.     End If
  52. '------------------------------------------------------------
  53. End Sub
  54. '------------------------------------------------------------
  55.  
  56. '------------------------------------------------------------
  57. Public Sub AddURLDocToTree(Tree As TreeView, pNode As Node, Doc As String)
  58. '------------------------------------------------------------
  59.     Dim sURL As String
  60.     Dim pURL As String
  61.     Dim URL As String
  62.     Dim uBegin As Long
  63.     Dim uEnd As Long
  64.     Dim pos As Long
  65. '------------------------------------------------------------
  66.     pURL = LCase$(pNode.Key)                            ' Get Parent URL...
  67.     If ((Left$(Right$(pURL, 4), 1) = ".") Or _
  68.         (Left$(Right$(pURL, 5), 1) = ".")) Then         ' If check if URL string has extention at the end
  69.         For pos = Len(pURL) To 1 Step -1                ' Step through each char. starting from right
  70.             If (Mid$(pURL, pos, 1) = "/") Then Exit For ' if sepparator found then finish
  71.         Next
  72.         pURL = Mid$(pURL, 1, pos)                       ' Extract parent URL...
  73.     End If
  74.     
  75.     pos = InStr(8, pURL, "/") - 1                       ' bug
  76.     If (pos > 0) Then
  77.         sURL = Mid(pURL, 1, pos)
  78.     Else
  79.         sURL = pURL
  80.     End If                                              ' end bug
  81.     
  82.     Doc = LCase(Doc)                                    ' Copy http page to all lower case
  83.     uBegin = 1                                          ' initialize search variables...
  84.     uEnd = 0                                            '
  85.     With Tree.Nodes
  86.     Do                                                  ' do while more not at end of document
  87.         If GetNextTagValue("href", Doc, uBegin, uEnd, URL) Then
  88.             On Error Resume Next
  89.             
  90.             pos = InStr(1, URL, ":")
  91.             If (pos > 0) Then
  92.                 Select Case Mid$(URL, 1, (pos - 1))
  93.                 Case "http", "file"
  94.                     Call .Add(pNode, tvwChild, URL, URL, icoWEBPAGE)
  95.                 Case "ftp"
  96.                 Case "mailto"
  97.                 End Select
  98.             Else
  99.                 If (Left$(URL, 1) = "/") Then
  100.                     Call .Add(pNode, tvwChild, sURL & URL, URL, icoWEBDOC)
  101.                 Else
  102.                     Call .Add(pNode, tvwChild, pURL & URL, URL, icoWEBDOC)
  103.                 End If
  104.             End If
  105.         End If
  106.         
  107.         If Not ((uBegin > 1) And (uEnd > 0)) Then Exit Do
  108.     Loop Until URL = ""                                     ' Continue searching document for URL ref.s
  109.     End With
  110. '------------------------------------------------------------
  111. End Sub
  112. '------------------------------------------------------------
  113.  
  114. '------------------------------------------------------------
  115. Public Function GetNextTagValue(Tag As String, Doc As String, uBegin As Long, uEnd As Long, URL As String) As Boolean
  116. '------------------------------------------------------------
  117.     uBegin = InStr(uBegin, Doc, Tag)                        ' Search for tag value
  118.     If (uBegin > 0) Then                                    ' tag found...
  119.         uBegin = InStr(uBegin, Doc, """") + 1               ' search for begin quote
  120.         If (uBegin > 1) Then                                ' begin quote found...
  121.             uEnd = InStr(uBegin, Doc, """") - 1             ' search for end quote
  122.             If (uEnd > 0) Then                              ' end quote found
  123.                 URL = Mid$(Doc, uBegin, (uEnd - uBegin + 1)) ' Extract URL string from doc
  124.                 GetNextTagValue = True
  125.                 
  126.                 If (Right$(URL, 1) <> "/") Then
  127.                     If ((Mid$(Right$(URL, 4), 1, 1) <> ".") And _
  128.                         (Mid$(Right$(URL, 5), 1, 1) <> ".")) Then
  129.                         URL = URL & "/"
  130.                     End If
  131.                 End If
  132.             End If
  133.         End If
  134.     End If
  135. '------------------------------------------------------------
  136. End Function
  137. '------------------------------------------------------------
  138.